home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 May / Macworld (1999-05).dmg / Updaters / Workplace Client 4.2 / TeamWave Workplace / TeamWave Workplace.rsrc / TEXT_3_dialog.txt < prev    next >
Encoding:
Text File  |  1999-03-03  |  5.3 KB  |  175 lines
  1. # dialog.tcl --
  2. #
  3. # This file defines the procedure tk_dialog, which creates a dialog
  4. # box containing a bitmap, a message, and one or more buttons.
  5. #
  6. # SCCS: @(#) dialog.tcl 1.33 97/06/06 11:20:04
  7. #
  8. # Copyright (c) 1992-1993 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #
  16. # tk_dialog:
  17. #
  18. # This procedure displays a dialog box, waits for a button in the dialog
  19. # to be invoked, then returns the index of the selected button.  If the
  20. # dialog somehow gets destroyed, -1 is returned.
  21. #
  22. # Arguments:
  23. # w -        Window to use for dialog top-level.
  24. # title -    Title to display in dialog's decorative frame.
  25. # text -    Message to display in dialog.
  26. # bitmap -    Bitmap to display in dialog (empty string means none).
  27. # default -    Index of button that is to display the default ring
  28. #        (-1 means none).
  29. # args -    One or more strings to display in buttons across the
  30. #        bottom of the dialog box.
  31.  
  32. proc tk_dialog {w title text bitmap default args} {
  33.     global tkPriv tcl_platform
  34.  
  35.     # 1. Create the top-level window and divide it into top
  36.     # and bottom parts.
  37.  
  38.     catch {destroy $w}
  39.     toplevel $w -class Dialog
  40.     wm title $w $title
  41.     wm iconname $w Dialog
  42.     wm protocol $w WM_DELETE_WINDOW { }
  43.  
  44.     # The following command means that the dialog won't be posted if
  45.     # [winfo parent $w] is iconified, but it's really needed;  otherwise
  46.     # the dialog can become obscured by other windows in the application,
  47.     # even though its grab keeps the rest of the application from being used.
  48.  
  49.     wm transient $w [winfo toplevel [winfo parent $w]]
  50.     if {$tcl_platform(platform) == "macintosh"} {
  51.     unsupported1 style $w dBoxProc
  52.     }
  53.  
  54.     frame $w.bot
  55.     frame $w.top
  56.     if {$tcl_platform(platform) == "unix"} {
  57.     $w.bot configure -relief raised -bd 1
  58.     $w.top configure -relief raised -bd 1
  59.     }
  60.     pack $w.bot -side bottom -fill both
  61.     pack $w.top -side top -fill both -expand 1
  62.  
  63.     # 2. Fill the top part with bitmap and message (use the option
  64.     # database for -wraplength so that it can be overridden by
  65.     # the caller).
  66.  
  67.     option add *Dialog.msg.wrapLength 3i widgetDefault
  68.     label $w.msg -justify left -text $text
  69.     if {$tcl_platform(platform) == "macintosh"} {
  70.     $w.msg configure -font system
  71.     } else {
  72.     $w.msg configure -font {Times 18}
  73.     }
  74.     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  75.     if {$bitmap != ""} {
  76.     if {($tcl_platform(platform) == "macintosh") && ($bitmap == "error")} {
  77.         set bitmap "stop"
  78.     }
  79.     label $w.bitmap -bitmap $bitmap
  80.     pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  81.     }
  82.  
  83.     # 3. Create a row of buttons at the bottom of the dialog.
  84.  
  85.     set i 0
  86.     foreach but $args {
  87.     button $w.button$i -text $but -command "set tkPriv(button) $i"
  88.     if {$i == $default} {
  89.         $w.button$i configure -default active
  90.     } else {
  91.         $w.button$i configure -default normal
  92.     }
  93.     grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
  94.     grid columnconfigure $w.bot $i
  95.     # We boost the size of some Mac buttons for l&f
  96.     if {$tcl_platform(platform) == "macintosh"} {
  97.         set tmp [string tolower $but]
  98.         if {($tmp == "ok") || ($tmp == "cancel")} {
  99.         grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
  100.         }
  101.     }
  102.     incr i
  103.     }
  104.  
  105.     # 4. Create a binding for <Return> on the dialog if there is a
  106.     # default button.
  107.  
  108.     if {$default >= 0} {
  109.     bind $w <Return> "
  110.         $w.button$default configure -state active -relief sunken
  111.         update idletasks
  112.         after 100
  113.         set tkPriv(button) $default
  114.     "
  115.     }
  116.  
  117.     # 5. Create a <Destroy> binding for the window that sets the
  118.     # button variable to -1;  this is needed in case something happens
  119.     # that destroys the window, such as its parent window being destroyed.
  120.  
  121.     bind $w <Destroy> {set tkPriv(button) -1}
  122.  
  123.     # 6. Withdraw the window, then update all the geometry information
  124.     # so we know how big it wants to be, then center the window in the
  125.     # display and de-iconify it.
  126.  
  127.     wm withdraw $w
  128.     update idletasks
  129.     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  130.         - [winfo vrootx [winfo parent $w]]]
  131.     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  132.         - [winfo vrooty [winfo parent $w]]]
  133.     wm geom $w +$x+$y
  134.     wm deiconify $w
  135.  
  136.     # 7. Set a grab and claim the focus too.
  137.  
  138.     set oldFocus [focus]
  139.     set oldGrab [grab current $w]
  140.     if {$oldGrab != ""} {
  141.     set grabStatus [grab status $oldGrab]
  142.     }
  143.     grab $w
  144.     if {$default >= 0} {
  145.     focus $w.button$default
  146.     } else {
  147.     focus $w
  148.     }
  149.  
  150.     # 8. Wait for the user to respond, then restore the focus and
  151.     # return the index of the selected button.  Restore the focus
  152.     # before deleting the window, since otherwise the window manager
  153.     # may take the focus away so we can't redirect it.  Finally,
  154.     # restore any grab that was in effect.
  155.  
  156.     tkwait variable tkPriv(button)
  157.     catch {focus $oldFocus}
  158.     catch {
  159.     # It's possible that the window has already been destroyed,
  160.     # hence this "catch".  Delete the Destroy handler so that
  161.     # tkPriv(button) doesn't get reset by it.
  162.  
  163.     bind $w <Destroy> {}
  164.     destroy $w
  165.     }
  166.     if {$oldGrab != ""} {
  167.     if {$grabStatus == "global"} {
  168.         grab -global $oldGrab
  169.     } else {
  170.         grab $oldGrab
  171.     }
  172.     }
  173.     return $tkPriv(button)
  174. }
  175.